Histograms

Haley Jeppson

2018-06-11

This document is adapted from the Bar Charts section of the Altair Example Gallery.

Our first step is to set up our environment:

# devtools::install_github("vegawidget/altair")
library("altair")
library("tibble")
library("tidyr")

vega_data <- import_vega_data()

Histogram with a Global Mean Overlay

Altair example

Data

glimpse(vega_data$movies())
#> Observations: 3,201
#> Variables: 16
#> $ Creative_Type          <list> [NULL, NULL, NULL, NULL, "Contemporary...
#> $ Director               <list> [NULL, NULL, NULL, NULL, NULL, NULL, "...
#> $ Distributor            <list> ["Gramercy", "Strand", "Lionsgate", "F...
#> $ IMDB_Rating            <dbl> 6.1, 6.9, 6.8, NaN, 3.4, NaN, 7.7, 3.8,...
#> $ IMDB_Votes             <dbl> 1071, 207, 865, NaN, 165, NaN, 15133, 3...
#> $ MPAA_Rating            <list> ["R", "R", NULL, NULL, "R", NULL, "R",...
#> $ Major_Genre            <list> [NULL, "Drama", "Comedy", "Comedy", "D...
#> $ Production_Budget      <dbl> 8000000, 300000, 250000, 300000, 100000...
#> $ Release_Date           <list> ["12-Jun-98", "7-Aug-98", "28-Aug-98",...
#> $ Rotten_Tomatoes_Rating <dbl> NaN, NaN, NaN, 13, 62, NaN, NaN, NaN, 2...
#> $ Running_Time_min       <dbl> NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN,...
#> $ Source                 <list> [NULL, NULL, NULL, NULL, "Original Scr...
#> $ Title                  <list> ["The Land Girls", "First Love, Last R...
#> $ US_DVD_Sales           <dbl> NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN,...
#> $ US_Gross               <dbl> 146083, 10876, 203134, 373615, 1009819,...
#> $ Worldwide_Gross        <dbl> 146083, 10876, 203134, 373615, 1087521,...

Chart

data <- r_to_py(vega_data$movies())

bar <- 
  alt$Chart(data)$
  mark_bar()$
  encode(
    x = alt$X("IMDB_Rating:Q", bin=TRUE, axis=NULL),
    y = alt$Y("count(IMDB_Rating)")
  )

rule <- 
  alt$Chart(data)$
  mark_rule(color = "red")$
  encode(
    x = "mean(IMDB_Rating):Q",
    size = alt$value(5)
  )

chart <- (bar + rule)

chart

Layered Histogram

Altair example

Data

Definition

data <- 
  data_frame(
    Trial_A = rnorm(1000, 0, 0.8),
    Trial_B = rnorm(1000, -2, 1),
    Trial_C = rnorm(1000, 3, 2)
  ) %>%
  gather(Experiment, Measurement)

glimpse(data)
#> Observations: 3,000
#> Variables: 2
#> $ Experiment  <chr> "Trial_A", "Trial_A", "Trial_A", "Trial_A", "Trial...
#> $ Measurement <dbl> 0.74492864, 0.54322207, -1.24771012, -0.86185392, ...

Chart

chart <- 
  alt$Chart(r_to_py(data))$
  mark_area(opacity = 0.3, interpolate="step")$
  encode(
    x = alt$X("Measurement", bin = alt$Bin(maxbins = 100)),
    y = alt$Y("count(Measurement)", stack = NULL),
    color = alt$Color(
      "Experiment",
      scale = alt$Scale(range = list("#0000ff", "#008000", "#ff0000"))
    )
  )

chart

Trellis Histogram

Altair example

This example is originally from Vega-Lite.

Data

glimpse(vega_data$cars())
#> Observations: 406
#> Variables: 9
#> $ Acceleration     <dbl> 12.0, 11.5, 11.0, 12.0, 10.5, 10.0, 9.0, 8.5,...
#> $ Cylinders        <dbl> 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 4, 8, 8, 8, 8, ...
#> $ Displacement     <dbl> 307, 350, 318, 304, 302, 429, 454, 440, 455, ...
#> $ Horsepower       <dbl> 130, 165, 150, 150, 140, 198, 220, 215, 225, ...
#> $ Miles_per_Gallon <dbl> 18, 15, 18, 16, 17, 15, 14, 14, 14, 15, NaN, ...
#> $ Name             <chr> "chevrolet chevelle malibu", "buick skylark 3...
#> $ Origin           <chr> "USA", "USA", "USA", "USA", "USA", "USA", "US...
#> $ Weight_in_lbs    <dbl> 3504, 3693, 3436, 3433, 3449, 4341, 4354, 431...
#> $ Year             <dttm> 1970-01-01, 1970-01-01, 1970-01-01, 1970-01-...

Chart

chart <- 
  alt$Chart(r_to_py(vega_data$cars()))$
  mark_bar()$
  encode(
    x = alt$X("Horsepower:Q", bin = TRUE),
    y = "count(Horsepower)",
    row = "Origin"
  )

chart